Mehr ggplot2!

Ziel

Wir wollen jetzt Charactereigenschaften von Personen aus zwei TV-Shows vergleichen. Ich nehme Friends und How I Met Your Mother.

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point()

Let’s build a plot!

Skalen und Legenden

Umwandlung von Datenwerten in visuelle Eigenschaften

Skalen




Scales in ggplot2 control the mapping from data to aesthetics. They take your data and turn it into something that you can see, like size, colour, position or shape.

ggplot2: Elegant Graphics for Data Analysis

Legenden

  • Legenden werden automatisch erzeugt.
  • Jede Skala bekommt eine Legende zugeordnet.
  • Sie nehmen die grafischen Eigenschaften (Aesthetics) und ordnen sie den Datenwerten zu. Man kann sie daher als die „Umkehrfunktion“ der jeweiligen Skalen verstehen.

Legenden und Achsen sind funktional äquivalent und werden in ggplot2 unter dem Begriff guides zusammengefasst.

Jede Aesthetic im Plot ist mit genau einer Skala verbunden:

Implizite Definition

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point()

Wird intern zu:

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  scale_x_discrete() +
  scale_y_continuous() +
  scale_colour_discrete() +
  scale_shape_discrete()




  • question ist eine diskrete Variable: scale_x_discrete()
  • avg_rating ist kontinuierlich: scale_x_continuous()
  • char_name und uni_name sind diskret: scale_colour_discrete() und scale_shape_discrete()

Das können wir uns zunutze machen, um manuell Scales zu definieren.

Ändern der Skalen-Defaults

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  scale_x_discrete(name = "Eigenschaft") +
  scale_y_continuous(name = "Mittleres Rating") +
  scale_colour_discrete(name = "Charakter") +
  scale_shape_discrete(name = "Serie")

Eigentlich würden wir dafür labs(x = "Eigenschaft", y = "Mittleres Rating", color = "Charakter", shape = "Serie") nutzen. Wir sehen so aber, dass Achsen- und Legendentitel jeweils Skalennamen sind.

Skalentypen

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = avg_rating, shape = uni_name)) +
  geom_point() +
  scale_y_log10(name = "Mittleren Rating log") +
  scale_colour_continuous()

Hier haben wir jetzt eine log-transormierende und eine kontinuierliche Skala.

Eine Übersicht über die möglichen Skalentypen findet sich hier.

Anwendungsfälle: Farben/Formen

Oft macht es Sinn, die Farben direkt über einen named vector zu definieren. Dadurch bekommen alle Plots, die diese Variablen nutzen, auch sicher die gleichen Aesthetics zugeordnet. Dadurch wird jedem Element in der color-variable genau die gewünschte Farbe zugeordnet:

char_colors <- c(
    "Ted Mosby" = "blue", "Robin Scherbatsky" = "red", "Barney Stinson" = "green", "Lily Aldrin" = "purple", "Marshall Eriksen" = "orange", "Rachel Green" = "pink", "Monica Geller" = "brown", "Phoebe Buffay" = "yellow", "Joey Tribbiani" = "cyan")
char_shapes <- c("Friends" = 12, "How I Met Your Mother" = 18)

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point(size = 3) +
  scale_shape_manual(values = char_shapes) +
  scale_colour_manual(values = char_colors)

Anwendungsfälle: Farben/Formen

Wenn ich dieselben Skalen für mehrere Plots nutzen will, kann ich mir auch vorher eine Funktion definieren:

set_char_scales <- function() {
  char_colors <- c(
    "Ted Mosby" = "blue", "Robin Scherbatsky" = "red", "Barney Stinson" = "green", "Lily Aldrin" = "purple", "Marshall Eriksen" = "orange", "Rachel Green" = "pink", "Monica Geller" = "brown", "Phoebe Buffay" = "yellow", "Joey Tribbiani" = "cyan")
  char_shapes <- c("Friends" = 12, "How I Met Your Mother" = 18)
  
  ## Output
  list(
    scale_shape_manual(values = char_shapes),
    scale_colour_manual(values = char_colors)
  )
}

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)
) +
  geom_point(size = 3) +
  set_char_scales()

Anwendungsfälle: Skalen-Ticks

Versuche, die y-Achse so zu skalieren, dass sie von 0 bis 100 geht und in 10er Schritten skaliert ist. Nutze die interne R-Hilfe, aber verzichte auf Internet/KI.

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point()
ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  scale_y_continuous(name = "Mittleres Rating", 
                     breaks = seq(0, 100, by = 10), 
                     limits = c(0, 100))

Scale Guides

Jede Skala (und damit jede Aesthetic) bekommt einen Guide zugeordnet. Intern passiert das über guides(). Wir können guides() also nutzen, um die Legende zu stylen:

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(color = guide_legend(title = "Charaktere", 
                              ncol = 3, ## Mehr Spalten in der Legende
                              reverse = TRUE, ## Reihenfolge umkehren
                              override.aes = list(size = 3))) ## Größe der Punkte in der Legende ändern

Mögliche guide-Funktionen

  • guide_colourbar()
  • guide_coloursteps()
  • guide_axis()
  • guide_legend()
  • guide_bins()

Nutze das gerade gelernte und versuche, die x-Achsenbeschriftung um 90 Grad zu drehen, um sie lesbar zu machen. Nutze die interne R-Hilfe, aber versuche, es ohne Internet/KI zu lösen:

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point()
ggplot(
  data = dat_prepped,
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90))

Ich nutze außerdem die Spalte top_trait, damit die Achsenbeschriftung kürzer wird. Das sieht schon besser aus, aber wir haben ein Overplotting-Problem!

Faceting



Aufteilen des Plots nach einer oder mehr Gruppen

Foto von Laura Cleffmann auf Unsplash

Faceting

Anordnen von einer einzelnen Variable in einem Raster:

facet_wrap(): Erstellt ein Band aus Kacheln

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")), ## Subset wegen Platzproblemen
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_wrap(vars(char_name), nrow = 4)

facet_grid(): Erstellt ein Grid aus Kacheln

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")),
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_grid(char_name ~ .)

Facetting - Mehrere Variablen

Anordnen von mehreren Variable in einem Raster:

facet_wrap()

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")),
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_wrap(vars(char_name, uni_name), nrow = 4)

facet_grid()

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")),
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_grid(char_name ~ uni_name)

Facetting - Tipps

Plot alle Punkte

dat_prepped_background <- dat_prepped %>%
  mutate(char_name_bg = char_name) %>%
  select(-char_name)

ggplot(dat_prepped, aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  # background lines: drawn in every facet, grouped by country_bg
  geom_point(
    data = dat_prepped_background,
    aes(group = char_name_bg),
    color = "grey70",
    alpha = 0.5,
    size = 0.4
  ) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_wrap(vars(char_name)) +
  guides(color = "none")

Facetting - Tipps

Plot Mittelwerte

Plot

Code

dat_mean <- dat_prepped %>%
  group_by(question) %>%
  summarise(mean_rating = mean(avg_rating)) %>% 
  ungroup() %>% 
  right_join(dat_prepped)


ggplot(dat_prepped, aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
geom_segment(
    aes(
      x = question, xend = question,
      y = 0, yend = avg_rating,
      group = interaction(char_name, uni_name)
    ),
    linewidth = 0.5,
    alpha = 0.5
  ) +
  geom_point(
    data = dat_mean,
    aes(x = question, y = avg_rating),
    inherit.aes = FALSE,
    color = "grey70",
    size = 1
  ) +
  geom_point() +
  facet_wrap(vars(char_name)) +
  guides(color = "none") +
  theme_bg()

:::

Standardisierung könnte beim Vergleich zwischen den Fragen helfen - das kommt aber auf die finale Fragestellung an. Ist aber ein Punkt, den man zumindest im Hinterkopf behalten sollte.

Sortieren

Sortieren, läuft in ggplot2 oft über factor(). Manchmal kann es hilfreich sein, sich eine eigene ID-Variable zum Sortieren zu erstellen

dat_prepped$uni_name_fac <- factor(dat_prepped$uni_name, levels = c("How I Met Your Mother", "Friends"))
ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(uni_name_fac), nrow = 4) +
  theme_bg()

Themes

Themes

Da würde man ja auch viel zur Legende ändern?

Labels

Koordinatensyteme

Koordinatensysteme

Zwei Aufgaben:

  • Kombinieren der Positions-Aesthetics (Positions 1 & Position 2) zu einem 2d Raum.
    • Linear: x & y
    • Polar: Winkel und Radius
    • Karte: Breite und Länge
  • Zeichnen der Achsen und Rasterlinien

Typen

Linear

  • coord_cartesian(): Default
  • coord_flip: Tauscht x und y Achse
  • coord_fixed(): Fixes Seitenverhältnis.

Nicht-linear

  • coord_map: Kartenprojektion
  • coord_polar: Polar-Koordinaten (Kreise)
  • coord_trans: Transformation der Positionen

Polar-Koordinaten

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name_fac, group = question)
) +
  geom_point() +
  geom_segment(
    aes(
      x = question, xend = question,
      y = 0, yend = avg_rating,
      group = interaction(char_name, uni_name_fac)
    ),
    linewidth = 0.5
  ) +
  ylim(0, 100) +
  facet_wrap(vars(char_name)) +
  coord_polar(theta = "x") +
  theme_bg()

Vorsicht damit! In vielen Fällen ist ein lineares Koordinatensystem einfacher zu interpretieren. Winkel sind oft nicht so einfach zu interpretieren. Nichtsdestotrotz kann es gerade zur Gestaltung nett sein!

Realistischer Anwendungen

  • Zeitreihen
  • Strecken

Kombinieren von Plots

Patchwork

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name))
dat_prepped_robin <- dat_prepped %>%
  filter(char_name == "Robin Scherbatsky")


p_robin <- ggplot(
  data = dat_prepped_robin,
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name)) +
  ylim(0, 100)



p_rest <- ggplot(
  data = dat_prepped %>% filter(char_name != "Robin Scherbatsky"),
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name), nrow = 2) +
  ylim(0, 100)

Patchwork

Patchwork erlaubt es, Plots zu kombinieren.

library(patchwork)

p_robin +
  p_rest

Patchwork: Stylen

library(patchwork)

p_robin +
  p_rest +
  plot_layout(widths = c(2, 2), guides = "collect")

Hmm, das hat noch nicht funktioniert.

Abschalten der Legende im ersten Plot.

p_robin <- ggplot(
  data = dat_prepped_robin,
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name)) +
  ylim(0, 100) +
  theme(legend.position = "none")



p_rest <- ggplot(
  data = dat_prepped %>% filter(char_name != "Robin Scherbatsky"),
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name), nrow = 2) +
  ylim(0, 100)


p_robin +
  p_rest +
  plot_layout(widths = c(2, 2), guides = "collect")

Text

Labeling

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_label(aes(label = char_name))

library(ggrepel)

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text_repel(aes(label = char_name))

Labeling von einzelnen Punkten

Erzeugen einer eigenen Spalte, die nur auf den gewünschten Punkten den Text enthält.

dat_prepped_2 <- dat_prepped %>%
  mutate(char_name_label = case_when(
    char_name == "Monica Geller" & top_trait == "orderly" ~ "Monica ist sehr ordentlich",
    TRUE ~ NA
  ))

ggplot(
  data = dat_prepped_2,
  mapping = aes(x = top_trait, y = avg_rating, shape = uni_name_fac, label = char_name_label, color = char_name)
) +
  geom_point() +
  geom_text_repel(nudge_x = 0.75, nudge_y = 1)

ggtext

ggtext erlaubt es, Markdown und HTML-Code in ggplot2 zu nutzen.

library(ggtext)

dat_prepped_2 <- dat_prepped %>%
  mutate(char_name_label = case_when(
    char_name == "Monica Geller" & top_trait == "orderly" ~ "Monica ist sehr <span style='color:black'>ordentlich</span>",
    TRUE ~ NA
  ))

ggplot(
  data = dat_prepped_2,
  mapping = aes(x = top_trait, y = avg_rating, shape = uni_name_fac, label = char_name_label, color = char_name)
) +
  geom_point() +
  geom_richtext(
    nudge_x = 0.75, nudge_y = 1, fill = NA, label.color = NA, # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt")
  )

dat_prepped_2 <- dat_prepped %>%
  mutate(char_name_bold = paste0("**", char_name, "**"))


ggplot(
  data = dat_prepped_2,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name_bold)) +
  theme(
    strip.text = element_markdown()
  )

Adjustment: hjust/vjust vs. nudge_x/nudge_y

hjust

::: {.column width=“33%”}}

ggplot( 
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), hjust = 0.5)

::: {.column width=“33%”}}

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), hjust = 0)

:::

::: {.column width=“33%”}}

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), hjust = 1)

::: :::

vjust

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), vjust = 1)

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), vjust = 0)

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), vjust = -1)

nudge

Nudging erfolgt auf der gleichen Skala wie die Werte.

::: {.column width=“50%”}}

Nudge um eine halbe Einheit nach rechts.

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), nudge_x = 0.5)

::: {.column width=“50%”}}

Nudge um 5 Einheiten nach unten.

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), nudge_y = -5)

::: :::

Bilder

library(tidyverse)
library(ggtext)
library(glue)

ggplot(
  data = dat_prepped,
  mapping = aes(x = image_link, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(question), nrow = 2) +
  ylim(0, 100) +
  scale_x_discrete(
    labels = \(x) glue("<img src='{x}' height='24' />")
  ) +
  theme(
    axis.text.x = element_markdown()
  ) +
  coord_cartesian(clip = "off") # falls Bilder abgeschnitten werden

Themes

Themes

library(tidyverse)
library(ggtext)
library(glue)

ggplot(
  data = dat_prepped,
  mapping = aes(x = image_link, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(question), nrow = 2) +
  ylim(0, 100) +
  scale_x_discrete(
    labels = \(x) glue("<img src='{x}' height='24' />")
  ) +
  theme(
    axis.text.x = element_markdown()
  ) +
  coord_cartesian(clip = "off") # falls Bilder abgeschnitten werden

Let’s bring it together: Spider-Chat

Step by step

# traits <- c("doer/thinker", "jock/nerd", "cold/warm", "main character/side character", "crazy/sane")
# line<-data.frame(x=rep(traits,2),y=c(rep(0, length(traits)),rep(100, length(traits))))


ggplot(
  dat_prepped,
  aes(x = question, y = avg_rating, group = char_name)
) +
  geom_point()

Spider-Chart

ggplot(
  dat_prepped,
  aes(x = question, y = avg_rating, group = char_name)
) +
  geom_point() +
  facet_wrap(vars(char_name), ncol = 4)

Vergleichen von ähnlichen Charakteren

Dafür erzeuge ich eine eigene Variable

dat_prepped2 <- dat_prepped %>%
  mutate(facet_id = case_when(
    char_name %in% c("Barney Stinson", "Joey Tribbiani") ~ "Barney & Joey",
    char_name %in% c("Ted Mosby", "Ross Geller") ~ "Ted & Ross",
    char_name %in% c("Robin Scherbatsky", "Rachel Green") ~ "Robin & Rachel",
    char_name %in% c("Lily Aldrin", "Monica Geller") ~ "Lily & Monica",
    char_name %in% c("Marshall Eriksen", "Chandler Bing") ~ "Marshall & Chandler"
  )) %>%
  filter(!is.na(facet_id)) ## Sorry Phoebe :(

ggplot(
  dat_prepped2,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name)
) +
  geom_point() +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100)

ggplot(
  dat_prepped2,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name)
) +
  geom_point() +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_polar()

ggplot(
  dat_prepped2,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.5) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_polar()

Radar coords from Tanya Shapiro

Code 
coord_radar <- function(theta = "x", start = 0, direction = 1) {
  theta <- match.arg(theta, c("x", "y"))
  r <- if (theta == "x") {
    "y"
  } else {
    "x"
  }

  # dirty
  rename_data <- function(coord, data) {
    if (coord$theta == "y") {
      plyr::rename(data, c("y" = "theta", "x" = "r"), warn_missing = FALSE)
    } else {
      plyr::rename(data, c("y" = "r", "x" = "theta"), warn_missing = FALSE)
    }
  }
  theta_rescale <- function(coord, x, scale_details) {
    rotate <- function(x) (x + coord$start) %% (2 * pi) * coord$direction
    rotate(scales::rescale(x, c(0, 2 * pi), scale_details$theta.range))
  }

  r_rescale <- function(coord, x, scale_details) {
    scales::rescale(x, c(0, 0.4), scale_details$r.range)
  }

  ggproto("CordRadar", CoordPolar,
    theta = theta, r = r, start = start,
    direction = sign(direction),
    is_linear = function(coord) TRUE,
    render_bg = function(self, scale_details, theme) {
      scale_details <- rename_data(self, scale_details)

      theta <- if (length(scale_details$theta.major) > 0) {
        theta_rescale(self, scale_details$theta.major, scale_details)
      }
      thetamin <- if (length(scale_details$theta.minor) > 0) {
        theta_rescale(self, scale_details$theta.minor, scale_details)
      }
      thetafine <- seq(0, 2 * pi, length.out = 100)

      rfine <- c(r_rescale(self, scale_details$r.major, scale_details))

      # This gets the proper theme element for theta and r grid lines:
      #   panel.grid.major.x or .y
      majortheta <- paste("panel.grid.major.", self$theta, sep = "")
      minortheta <- paste("panel.grid.minor.", self$theta, sep = "")
      majorr <- paste("panel.grid.major.", self$r, sep = "")

      ggplot2:::ggname("grill", grid::grobTree(
        ggplot2:::element_render(theme, "panel.background"),
        if (length(theta) > 0) {
          ggplot2:::element_render(
            theme, majortheta,
            name = "angle",
            x = c(rbind(0, 0.4 * sin(theta))) + 0.5,
            y = c(rbind(0, 0.4 * cos(theta))) + 0.5,
            id.lengths = rep(2, length(theta)),
            default.units = "native"
          )
        },
        if (length(thetamin) > 0) {
          ggplot2:::element_render(
            theme, minortheta,
            name = "angle",
            x = c(rbind(0, 0.4 * sin(thetamin))) + 0.5,
            y = c(rbind(0, 0.4 * cos(thetamin))) + 0.5,
            id.lengths = rep(2, length(thetamin)),
            default.units = "native"
          )
        },
        ggplot2:::element_render(
          theme, majorr,
          name = "radius",
          x = rep(rfine, each = length(thetafine)) * sin(thetafine) + 0.5,
          y = rep(rfine, each = length(thetafine)) * cos(thetafine) + 0.5,
          id.lengths = rep(length(thetafine), length(rfine)),
          default.units = "native"
        )
      ))
    }
  )
}
dat_prepped3 <- arrange(dat_prepped2, question)

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = char_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.5) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar()

https://de.pinterest.com/pin/friends-colors–2955556002181108/

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg()

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg() +
  labs(title = "The one where Everyone meets", )

library(ggimage)

dat_prepped3 <- dat_prepped3 %>%
  mutate(
    image_x = ifelse(uni_name == "Friends", -1, 1),
    image_x_coord = ifelse(uni_name == "Friends", "doer/thinker", "crazy/sane")
  )

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg() +
  labs(title = "The one where Everyone meets") +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link),
    nudge_x = c(0.5, -0.5),
    size = 0.1, inherit.aes = FALSE
  ) +
  NULL

Adding a frame around the picture

library(ggimage)

dat_prepped3 <- dat_prepped3 %>%
  mutate(
    image_x = ifelse(uni_name == "Friends", -1, 1),
    image_x_coord = ifelse(uni_name == "Friends", "doer/thinker", "crazy/sane")
  )

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg() +
  labs(title = "The one where Everyone meets") +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link),
    nudge_x = c(0.5, -0.5),
    size = 0.12
  ) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link),
    nudge_x = c(0.5, -0.5),
    size = 0.1, inherit.aes = FALSE
  ) +
  NULL

Styling

  • Anchor points on top to show max
  • Style
  • Nudge pictures further out
dat_prepped3 <- dat_prepped3 %>%
  mutate(
    image_x = ifelse(uni_name == "Friends", -1, 1),
    image_x_coord = ifelse(uni_name == "Friends", "low IQ", "side character")
  ) %>%
  arrange(top_trait)

outer_points <- dat_prepped3 %>%
  mutate(
    max_rating = 100,
    label_y = 90, 
    nudge_x = ifelse(uni_name == "Friends", -0.14, 0.14)
  )

ggplot(
  dat_prepped3,
  aes(x = top_trait, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point(data = outer_points, aes(top_trait, max_rating), color = "white", inherit.aes = FALSE) +
  geom_richtext(
    data = outer_points, aes(top_trait, label_y, label = round(avg_rating, 0), color = uni_name), inherit.aes = FALSE, fill = NA, label.color = NA,
    label.padding = grid::unit(rep(0, 4), "pt"), nudge_x = outer_points$nudge_x, size = 2
  ) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#36d1ab", "How I Met Your Mother" = "#FFED29")) +
  scale_color_manual(values = c("Friends" = "#9C8CD4", "How I Met Your Mother" = "#FFED29")) +
  theme_bw() +
  labs(title = "The one where Everyone meets") +
    geom_image(aes(x = image_x_coord, y = 100, image = image_link),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.12) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.1, inherit.aes = FALSE) +
  theme(
    axis.ticks = element_blank(),
    axis.text.x = element_text(color = "white", face = "bold"), 
    axis.text.y = element_blank(), 
    axis.title = element_blank(), 
    panel.background = element_rect(fill = "#06402B"), 
    plot.background = element_rect(fill = '#06402B'), 
    title = element_text(color = "white", size = 16, face = "bold"), 
    strip.background = element_rect(fill = "#06402B"), 
    strip.text = element_text(color = "white", face = "bold"), 
    legend.background = element_rect(fill = "#06402B"), 
    legend.text = element_text(color = "white")
  )

dat_joey_barney <- dat_prepped3 %>%
  filter(char_name %in% c("Barney Stinson", "Joey Tribbiani"))


  outer_points_joey_barney <- dat_joey_barney %>%
  mutate(
    max_rating = 100,
    label_y = 95, 
    nudge_x = ifelse(uni_name == "Friends", -0.1, 0.1)
  )
    
p_left <- ggplot(
  dat_joey_barney,
  aes(x = top_trait, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point(data = outer_points_joey_barney, aes(top_trait, max_rating), color = "white", inherit.aes = FALSE) +
  geom_richtext(
    data = outer_points_joey_barney, aes(top_trait, label_y, label = round(avg_rating, 0), color = uni_name), inherit.aes = FALSE, fill = NA, label.color = NA,
    label.padding = grid::unit(rep(0, 4), "pt"), nudge_x = outer_points_joey_barney$nudge_x, size = 2.75
  ) +
  geom_point(size = 3) +
  geom_polygon(alpha = 0.2, linewidth = 1.5) +
  facet_wrap(vars(facet_id), ncol = 2) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#36d1ab", "How I Met Your Mother" = "#FFED29")) +
  scale_color_manual(values = c("Friends" = "#9C8CD4", "How I Met Your Mother" = "#FFED29")) +
  theme_bw() +
  labs(title = "The one where Everyone meets", 
       subtitle = "Character ratings from 0 to 100") +
    geom_image(aes(x = image_x_coord, y = 100, image = image_link),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.12) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.1, inherit.aes = FALSE) +
  theme(
    axis.ticks = element_blank(),
    axis.text.x = element_text(color = "white", face = "bold"), 
    axis.text.y = element_blank(), 
    axis.title = element_blank(), 
    panel.background = element_rect(fill = "#06402B"), 
    plot.background = element_rect(fill = '#06402B'), 
    title = element_text(color = "white", size = 16, face = "bold"), 
    strip.background = element_rect(fill = "#06402B"), 
    strip.text = element_text(color = "white", face = "bold"), 
    legend.background = element_rect(fill = "#06402B"), 
    legend.position = "none"
  ) 
outer_points2 <- outer_points %>%
  filter(!char_name %in% c("Barney Stinson", "Joey Tribbiani"))

p_right <- ggplot(
  dat_prepped3 %>% filter(!char_name %in% c("Barney Stinson", "Joey Tribbiani")),
  aes(x = top_trait, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point(data = outer_points2, aes(top_trait, max_rating), color = "white", inherit.aes = FALSE) +
  geom_richtext(
    data = outer_points2, aes(top_trait, label_y, label = round(avg_rating, 0), color = uni_name), inherit.aes = FALSE, fill = NA, label.color = NA,
    label.padding = grid::unit(rep(0, 4), "pt"), nudge_x = outer_points2$nudge_x, size = 2.75
  ) +
  geom_point(size = 3) +
  geom_polygon(alpha = 0.2, linewidth = 1) +
  facet_wrap(vars(facet_id), ncol = 2) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#36d1ab", "How I Met Your Mother" = "#FFED29")) +
  scale_color_manual(values = c("Friends" = "#9C8CD4", "How I Met Your Mother" = "#FFED29")) +
  theme_bw() +
    geom_image(aes(x = image_x_coord, y = 100, image = image_link),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.12) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.1, inherit.aes = FALSE) +
  theme(
    axis.ticks = element_blank(),
    axis.text.x = element_text(color = "white"), 
    axis.text.y = element_blank(), 
    axis.title = element_blank(), 
    panel.background = element_rect(fill = "#053625"), 
    plot.background = element_rect(fill = '#053625'), 
    strip.background = element_rect(fill = "#053625"), 
    strip.text = element_text(color = "white", face = "bold"), 
    legend.position = "none"
  )
  • Eventuell in Funktionen packen was geht

Patch together

p_left +
  p_right

Abspeichern

Vektor vs Raster (Rolfs 7)

Use characters data for demonstration or for exercise?